Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/Finger 1.3.5/source/Finger/Preferences.p

Text File | 1992-02-24 | 7.2 KB | 331 lines | [TEXT/PJMM]

unit Preferences;

{ This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
{ Copyright 1991-1992 Peter N Lewis }
{ If you use this code, you must give me credit in your about box and documentation }

interface

    uses
        MyTypes, MyUtils, MyUtilities, MyFileSystem, MyStandardFile, Folders, MySystem7,{}
        BaseGlobals, AppGlobals, OOMainLoop, MyFMenus, PrefsGlobals, MyPreferences;

    procedure InitPreferences;
    function FinishPreferences: boolean;
    procedure GetPreferences (wdrn: integer; dirID: longInt; name: str63);  { used for ODoc/Params }
    procedure OpenPreferences;

implementation

    const
        Pref_Save_item = 1;
        Pref_Default_Item = Pref_Save_item;  { Must be one anyway, since we use OutlineDefault1 }
        Pref_Cancel_item = 2;
        Pref_OK_item = 3;

        User_item = 4;
        PFS_item = 5;
        PFB_item = 6;
        IPS_item = 7;
        AFS_item = 8;

    type
        PrefsObject = object(DObject)
                procedure Create (id: integer);
                override;
                procedure Destroy;
                override;
                procedure DoClose;
                override;
                procedure DoItem (item: integer);
                override;
            end;

    var
        noAlert: boolean;
        prefs_fs: FSSpec;
        dialog_prefs: prefsRecord;
        prefs_dialog_dirty: boolean;
        prefs_object: PrefsObject;

    procedure SetDialog (dp: dialogPtr);
    forward;

{$S}
    procedure SetPrefsMenu (themenu, theitem: integer);
    begin
        SetIDItemEnable(themenu, theitem, not IsWObjectFront(prefs_object));
    end;

{$S Init}
    procedure InitPreferences;
    begin
        prefs_object := nil;
        noAlert := false;
        GetPrefsFSSpec(prefs_fs);
        JustGetPrefs(prefs);
        SetFBoth(Cpreferences, @OpenPreferences, @SetPrefsMenu);
    end;

{$S PrefInit}
    procedure GetPreferences (wdrn: integer; dirID: longInt; name: str63);
        var
            oe: OSErr;
            a: integer;
            prefs_rn: integer;
    begin
        oe := MyResolveAliasFile(wdrn, dirID, name);
        prefs_fs.vRefNum := wdrn;
        prefs_fs.parID := dirID;
        prefs_fs.name := name;
        prefs_rn := OpenPrefsFile(prefs_fs);
        if prefs_rn <> -1 then begin
            GetPrefs(prefs);
            CloseResFile(prefs_rn);
            if prefs_object <> nil then
                SetDialog(prefs_object.window);
        end
        else if not noAlert then
            a := Alert(pref_read_alert_id, nil);
    end;

{$S Prefs}
    procedure SaveDefaults;
        var
            oe: OSErr;
            a: integer;
            name: str63;
            crdate: longInt;
    begin
        with prefs do begin
            if plan_dirID = -1 then
                oe := myErr
            else begin
                name := '';
                oe := GetVolInfo(name, plan_vrn, -1, crdate);
            end;
            if oe = noErr then
                if not MFSExists(plan_vrn, plan_dirID, plan_name) then
                    oe := myErr;
            if oe = noErr then begin
                plan_volume := name;
                plan_CrDate := crdate;
            end
            else begin
                plan_enabled := false;
                plan_DirID := -1;
                plan_CrDate := 0;
                plan_Volume := '';
            end;
        end;
        JustSetPrefs(prefs);
    end;

{$S Term}
    function FinishPreferences: boolean;
    begin
        if prefs_object <> nil then
            prefs_object.DoClose;
        FinishPreferences := prefs_object <> nil;
    end;

{$S Prefs}
    function GetControl (dp: dialogPtr; item: integer): boolean;
        var
            kind: integer;
            r: rect;
            h: controlHandle;
    begin
        GetDItem(dp, item, kind, handle(h), r);
        GetControl := GetCtlValue(h) <> 0;
    end;

{$S Prefs}
    procedure SetControl (dp: dialogPtr; item: integer; on: boolean);
        var
            kind: integer;
            r: rect;
            h: controlHandle;
    begin
        GetDItem(dp, item, kind, handle(h), r);
        SetCtlValue(h, ord(on));
        prefs_dialog_dirty := true;
    end;

{$S Prefs}
    procedure SetControls (dp: dialogPtr; first, count, value: integer);
        var
            i: integer;
    begin
        for i := 0 to count - 1 do
            SetControl(dp, first + i, i = value);
    end;

{$S Prefs}
    function GetControls (dp: dialogPtr; first, count: integer): integer;
        var
            i: integer;
    begin
        GetControls := 0;
        for i := 0 to count - 1 do
            if GetControl(dp, first + i) then
                GetControls := i;
    end;

{$S Prefs}
    procedure SetPlanButton (dp: dialogPtr; enabled: boolean; vrn: integer; dirID: longInt; name: str63);
        var
            kind: integer;
            hb, hs: handle;
            r: rect;
    begin
        with dialog_prefs do begin
            plan_enabled := enabled;
            plan_vrn := vrn;
            plan_dirID := dirID;
            plan_name := name;
        end;
        GetDItem(dp, PFB_item, kind, hb, r);
        GetDItem(dp, PFS_item, kind, hs, r);
        if dirID = -1 then begin
            SetCTitle(controlHandle(hb), GetGlobalString(pref_no_file));
            HiliteControl(controlHandle(hs), 255);
            SetCtlValue(controlHandle(hs), ord(enabled));
        end
        else begin
            SetCTitle(controlHandle(hb), name);
            HiliteControl(controlHandle(hs), 0);
            SetCtlValue(controlHandle(hs), ord(enabled));
        end;
        prefs_dialog_dirty := true;
    end;

{$S Prefs}
    procedure SetDialog (dp: dialogPtr);
    begin
        dialog_prefs := prefs;
        with prefs do begin
            SetPlanButton(dp, plan_enabled, plan_vrn, plan_DirID, plan_name);
            SetControl(dp, IPS_item, ShowIP);
            SetControl(dp, AFS_item, autoopen);
        end;
        prefs_dialog_dirty := false;
    end;

{$S Prefs}
    procedure GetDialog (dp: dialogPtr);
    begin
        prefs := dialog_prefs;
        with prefs do begin
            plan_enabled := GetControl(dp, PFS_item);
            showIP := GetControl(dp, IPS_item);
            autoopen := GetControl(dp, AFS_item);
        end;
        prefs_dialog_dirty := false;
    end;

{$S Prefs}
    procedure OpenPreferences;
    begin
        if prefs_object <> nil then begin
            if FrontWindow <> prefs_object.window then
                SelectWindow(prefs_object.window);
        end
        else begin
            new(prefs_object);
            prefs_object.Create(pref_dialog_id);
        end;
    end;

{$S Prefs}
    procedure PrefsObject.Create (id: integer);
    begin
        UseResFile(app_resfile);
        SetVersionParamText('', '');
        inherited Create(id);
        ok_item := Pref_Default_Item;
        cancel_item := Pref_Cancel_Item;
        SetUpDefaultOutline(window, Pref_Default_item, User_item);
        SetDialog(window);
        ShowWindow(window);
    end;

{$S Prefs}
    procedure Toggle (dp: dialogPtr; item: integer);
    begin
        prefs_dialog_dirty := true;
        SetControl(dp, item, not GetControl(dp, item));
    end;

{$S Prefs}
    procedure PrefsObject.DoItem (item: integer);
        procedure CheckClick (item: integer);
        begin
            SetControl(window, item, not GetControl(window, item));
        end;
        var
            reply: MySFReply;
            typeList: SFTypeList;
            dfs: boolean;
    begin
        with prefs do begin
            case item of
                IPS_item:
                    Toggle(window, IPS_item);
                AFS_item:
                    Toggle(window, AFS_item);
                PFS_item:
                    Toggle(window, PFS_item);
                PFB_item:  begin
                    if dialog_prefs.plan_dirID <> -1 then
                        SetSFFile(dialog_prefs.plan_vrn, dialog_prefs.plan_dirID);
                    typeList[0] := 'TEXT';
                    GetFile(nil, 1, typeList, reply);
                    with reply do
                        if Rgood then
                            SetPlanButton(window, true, RvRefNum, RdirID, Rfname);
                end;
                Pref_Save_item, Pref_OK_item, Pref_Cancel_item:  begin
                    if prefs_dialog_dirty and (item <> Pref_Cancel_item) then begin
                        GetDialog(window);
                        if item = Pref_Save_item then
                            SaveDefaults;
                    end;
                    Destroy;
                end;
                otherwise
                    ;
            end;
        end;
    end;

{$S Prefs}
    procedure PrefsObject.Destroy;
    begin
        inherited Destroy;
        prefs_object := nil;
    end;

{$S Prefs}
    procedure PrefsObject.DoClose;
        var
            dp: dialogPtr;
            sc: SCType;
    begin
        if prefs_dialog_dirty then begin
            if FrontWindow <> window then
                SelectWindow(window);
            sc := SaveChanges;
            if sc = SCSave then begin
                GetDialog(window);
                SaveDefaults;
            end;
        end
        else
            sc := SCDiscard;
        if sc <> SCCancel then begin
            Destroy;
        end;
    end;

end.